Function: smie-bnf->prec2

smie-bnf->prec2 is a byte-compiled function defined in smie.el.gz.

Signature

(smie-bnf->prec2 BNF &rest RESOLVERS)

Documentation

Convert the BNF grammar into a prec2 table.

BNF is a list of nonterminal definitions of the form:
  (NONTERM RHS1 RHS2 ...)
where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals. Not all grammars are accepted:
- an RHS cannot be an empty list (this is not needed, since SMIE allows all
  non-terminals to match the empty string anyway).
- an RHS cannot have 2 consecutive non-terminals: between each non-terminal
  needs to be a terminal (aka token). This is a fundamental limitation of
  the parsing technology used (operator precedence grammar).
Additionally, conflicts can occur:
- The returned prec2 table holds constraints between pairs of
  token, and for any given pair only one constraint can be
  present, either: T1 < T2, T1 = T2, or T1 > T2.
- A token can either be an opener (something similar to an open-paren),
  a closer (like a close-paren), or neither of the two (e.g. an infix
  operator, or an inner token like "else").
Conflicts can be resolved via RESOLVERS, which is a list of elements that can be either:
- a precs table (see smie-precs->prec2) to resolve conflicting constraints,
- a constraint (T1 REL T2) where REL is one of = < or >.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/smie.el.gz
(defun smie-bnf->prec2 (bnf &rest resolvers)
  "Convert the BNF grammar into a prec2 table.
BNF is a list of nonterminal definitions of the form:
  (NONTERM RHS1 RHS2 ...)
where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals.
Not all grammars are accepted:
- an RHS cannot be an empty list (this is not needed, since SMIE allows all
  non-terminals to match the empty string anyway).
- an RHS cannot have 2 consecutive non-terminals: between each non-terminal
  needs to be a terminal (aka token).  This is a fundamental limitation of
  the parsing technology used (operator precedence grammar).
Additionally, conflicts can occur:
- The returned prec2 table holds constraints between pairs of
  token, and for any given pair only one constraint can be
  present, either: T1 < T2, T1 = T2, or T1 > T2.
- A token can either be an `opener' (something similar to an open-paren),
  a `closer' (like a close-paren), or `neither' of the two (e.g. an infix
  operator, or an inner token like \"else\").
Conflicts can be resolved via RESOLVERS, which is a list of elements that can
be either:
- a precs table (see `smie-precs->prec2') to resolve conflicting constraints,
- a constraint (T1 REL T2) where REL is one of = < or >."
  (declare (pure t))
  ;; FIXME: Add repetition operator like (repeat <separator> <elems>).
  ;; Maybe also add (or <elem1> <elem2>...) for things like
  ;; (exp (exp (or "+" "*" "=" ..) exp)).
  ;; Basically, make it EBNF (except for the specification of a separator in
  ;; the repetition, maybe).
  (let* ((nts (mapcar #'car bnf))        ;Non-terminals.
         (first-ops-table ())
         (last-ops-table ())
         (first-nts-table ())
         (last-nts-table ())
         (smie-warning-count 0)
         (prec2 (make-hash-table :test 'equal))
         (override
          (let ((precs ())
                (over (make-hash-table :test 'equal)))
            (dolist (resolver resolvers)
              (cond
               ((and (= 3 (length resolver)) (memq (nth 1 resolver) '(= < >)))
                (smie-set-prec2tab
                 over (nth 0 resolver) (nth 2 resolver) (nth 1 resolver)))
               ((memq (caar resolver) '(left right assoc nonassoc))
                (push resolver precs))
               (t (error "Unknown resolver %S" resolver))))
            (apply #'smie-merge-prec2s over
                   (mapcar #'smie-precs->prec2 precs))))
         again)
    (dolist (rules bnf)
      (let ((nt (car rules))
            (last-ops ())
            (first-ops ())
            (last-nts ())
            (first-nts ()))
        (dolist (rhs (cdr rules))
          (unless (consp rhs)
            (signal 'wrong-type-argument `(consp ,rhs)))
          (if (not (member (car rhs) nts))
              (cl-pushnew (car rhs) first-ops)
            (cl-pushnew (car rhs) first-nts)
            (when (consp (cdr rhs))
              ;; If the first is not an OP we add the second (which
              ;; should be an OP if BNF is an "operator grammar").
              ;; Strictly speaking, this should only be done if the
              ;; first is a non-terminal which can expand to a phrase
              ;; without any OP in it, but checking doesn't seem worth
              ;; the trouble, and it lets the writer of the BNF
              ;; be a bit more sloppy by skipping uninteresting base
              ;; cases which are terminals but not OPs.
              (when (member (cadr rhs) nts)
                (error "Adjacent non-terminals: %s %s"
                       (car rhs) (cadr rhs)))
              (cl-pushnew (cadr rhs) first-ops)))
          (let ((shr (reverse rhs)))
            (if (not (member (car shr) nts))
                (cl-pushnew (car shr) last-ops)
              (cl-pushnew (car shr) last-nts)
              (when (consp (cdr shr))
                (when (member (cadr shr) nts)
                  (error "Adjacent non-terminals: %s %s"
                         (cadr shr) (car shr)))
                (cl-pushnew (cadr shr) last-ops)))))
        (push (cons nt first-ops) first-ops-table)
        (push (cons nt last-ops) last-ops-table)
        (push (cons nt first-nts) first-nts-table)
        (push (cons nt last-nts) last-nts-table)))
    ;; Compute all first-ops by propagating the initial ones we have
    ;; now, according to first-nts.
    (setq again t)
    (while (prog1 again (setq again nil))
      (dolist (first-nts first-nts-table)
        (let* ((nt (pop first-nts))
               (first-ops (assoc nt first-ops-table)))
          (dolist (first-nt first-nts)
            (dolist (op (cdr (assoc first-nt first-ops-table)))
              (unless (member op first-ops)
                (setq again t)
                (push op (cdr first-ops))))))))
    ;; Same thing for last-ops.
    (setq again t)
    (while (prog1 again (setq again nil))
      (dolist (last-nts last-nts-table)
        (let* ((nt (pop last-nts))
               (last-ops (assoc nt last-ops-table)))
          (dolist (last-nt last-nts)
            (dolist (op (cdr (assoc last-nt last-ops-table)))
              (unless (member op last-ops)
                (setq again t)
                (push op (cdr last-ops))))))))
    ;; Now generate the 2D precedence table.
    (dolist (rules bnf)
      (dolist (rhs (cdr rules))
        (while (cdr rhs)
          (cond
           ((member (car rhs) nts)
            (dolist (last (cdr (assoc (car rhs) last-ops-table)))
              (smie-set-prec2tab prec2 last (cadr rhs) '> override)))
           ((member (cadr rhs) nts)
            (dolist (first (cdr (assoc (cadr rhs) first-ops-table)))
              (smie-set-prec2tab prec2 (car rhs) first '< override))
            (if (and (cddr rhs) (not (member (car (cddr rhs)) nts)))
                (smie-set-prec2tab prec2 (car rhs) (car (cddr rhs))
                                   '= override)))
           (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override)))
          (setq rhs (cdr rhs)))))
    ;; Keep track of which tokens are openers/closer, so they can get a nil
    ;; precedence in smie-prec2->grammar.
    (puthash :smie-open/close-alist (smie-bnf--classify bnf) prec2)
    (puthash :smie-closer-alist (smie-bnf--closer-alist bnf) prec2)
    (if (> smie-warning-count 0)
        (display-warning
         'smie (format "Total: %d warnings" smie-warning-count)))
    prec2))